Data reading

hogwarts <- read_csv("data/hogwarts_2024.csv")
hogwarts |> head()
## # A tibble: 6 × 60
##      id house    course sex   wandCore bloodStatus result Defence against the …¹
##   <dbl> <chr>     <dbl> <chr> <chr>    <chr>        <dbl>                  <dbl>
## 1     1 Ravencl…      4 fema… unicorn… half-blood      94                     73
## 2     2 Hufflep…      5 male  phoenix… half-blood      33                     38
## 3     3 Ravencl…      4 fema… dragon … half-blood     137                     52
## 4     4 Hufflep…      2 male  phoenix… half-blood      27                     50
## 5     5 Hufflep…      2 fema… phoenix… half-blood      67                     47
## 6     6 Gryffin…      6 male  phoenix… muggle-born    126                     44
## # ℹ abbreviated name: ¹​`Defence against the dark arts exam`
## # ℹ 52 more variables: `Flying exam` <dbl>, `Astronomy exam` <dbl>,
## #   `Herbology exam` <dbl>, `Divinations exam` <dbl>, `Charms exam` <dbl>,
## #   `History of magic exam` <dbl>, `Arithmancy exam` <dbl>,
## #   `Care of magical creatures exam` <dbl>, `Muggle studies exam` <dbl>,
## #   `Study of ancient runes exam` <dbl>, `Transfiguration exam` <dbl>,
## #   `Potions exam` <dbl>, week_1 <dbl>, week_2 <dbl>, week_3 <dbl>, …

Checking dataset structure

hogwarts |> glimpse()
## Rows: 560
## Columns: 60
## $ id                                   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11…
## $ house                                <chr> "Ravenclaw", "Hufflepuff", "Raven…
## $ course                               <dbl> 4, 5, 4, 2, 2, 6, 7, 5, 2, 3, 7, …
## $ sex                                  <chr> "female", "male", "female", "male…
## $ wandCore                             <chr> "unicorn hair", "phoenix feather"…
## $ bloodStatus                          <chr> "half-blood", "half-blood", "half…
## $ result                               <dbl> 94, 33, 137, 27, 67, 126, 63, 7, …
## $ `Defence against the dark arts exam` <dbl> 73, 38, 52, 50, 47, 44, 51, 47, 2…
## $ `Flying exam`                        <dbl> 33, 36, 73, 42, 41, 52, 34, 34, 2…
## $ `Astronomy exam`                     <dbl> 57, 45, 66, 49, 57, 59, 58, 37, 5…
## $ `Herbology exam`                     <dbl> 73, 50, 62, 39, 38, 46, 59, 23, 2…
## $ `Divinations exam`                   <dbl> 66, 54, 72, 42, 47, 49, 42, 38, 1…
## $ `Charms exam`                        <dbl> 60, 70, 77, 46, 35, 55, 86, 20, 4…
## $ `History of magic exam`              <dbl> 52, 36, 60, 45, 50, 40, 55, 21, 2…
## $ `Arithmancy exam`                    <dbl> 61, 36, 58, 32, 76, 50, 41, 31, 2…
## $ `Care of magical creatures exam`     <dbl> 44, 41, 70, 36, 46, 73, 29, 36, 4…
## $ `Muggle studies exam`                <dbl> 64, 34, 52, 59, 50, 54, 36, 31, 4…
## $ `Study of ancient runes exam`        <dbl> 50, 35, 59, 39, 48, 56, 47, 41, 3…
## $ `Transfiguration exam`               <dbl> 74, 70, 70, 15, 32, 86, 100, 31, …
## $ `Potions exam`                       <dbl> 67, 38, 22, 64, 56, 60, 62, 55, 1…
## $ week_1                               <dbl> 0, -5, 0, -1, 1, 5, 1, -20, 3, -2…
## $ week_2                               <dbl> -10, 1, 0, 5, 20, 10, -5, 10, 1, …
## $ week_3                               <dbl> 0, -1, 1, -5, 10, -5, 3, -5, -3, …
## $ week_4                               <dbl> 10, 1, -1, 10, -10, 10, 0, -10, -…
## $ week_5                               <dbl> 3, -5, 3, 0, -1, 20, 5, 5, -3, 5,…
## $ week_6                               <dbl> -20, 20, 0, 0, 0, 0, 0, 5, 0, -1,…
## $ week_7                               <dbl> 10, 10, 1, -3, -20, 1, 10, 3, -5,…
## $ week_8                               <dbl> 5, 5, 1, -5, 5, 5, 0, 1, 0, 20, -…
## $ week_9                               <dbl> 1, 1, 3, -1, 0, 3, -20, -20, -10,…
## $ week_10                              <dbl> 20, -10, 1, 5, -1, 0, 5, -5, 5, 3…
## $ week_11                              <dbl> 5, -10, 20, 0, 0, 0, 5, 10, 5, 5,…
## $ week_12                              <dbl> 5, -5, 1, -20, -10, -5, 0, 5, 1, …
## $ week_13                              <dbl> -20, -5, 10, 0, 0, 1, -1, 10, -20…
## $ week_14                              <dbl> 0, 5, 3, 10, -10, 20, 0, -20, -20…
## $ week_15                              <dbl> 1, 20, 1, 0, -20, 10, 1, 3, -20, …
## $ week_16                              <dbl> 20, 5, 5, 5, 0, 3, 10, -1, 5, 5, …
## $ week_17                              <dbl> 3, 0, 10, 5, 5, -5, -1, 10, -10, …
## $ week_18                              <dbl> 10, 5, 5, 5, 10, -20, 0, 10, 3, 5…
## $ week_19                              <dbl> -10, 0, -5, -1, 0, -1, 0, 20, 0, …
## $ week_20                              <dbl> 10, -10, 5, 10, 0, -1, -1, 10, 0,…
## $ week_21                              <dbl> 0, 5, 5, 3, 5, 0, 0, -5, -5, 5, 5…
## $ week_22                              <dbl> 20, -5, 5, 0, 20, 5, -1, 0, 0, 20…
## $ week_23                              <dbl> 5, 1, -3, 20, -5, 20, 0, 1, 1, 5,…
## $ week_24                              <dbl> 10, -20, -20, 0, 10, 5, 5, -3, -5…
## $ week_25                              <dbl> 0, -20, 1, 3, 5, 1, -5, 0, -20, 2…
## $ week_26                              <dbl> 10, 10, 5, -1, 0, 5, 5, -3, 0, 20…
## $ week_27                              <dbl> 5, 5, -3, 0, 20, 5, 0, -5, 10, 3,…
## $ week_28                              <dbl> -3, 20, 20, 1, 10, 5, 1, 10, 0, 1…
## $ week_29                              <dbl> -20, -5, 5, 5, -10, 1, 0, -3, 0, …
## $ week_30                              <dbl> 5, 1, -5, 5, -5, -1, -20, 20, 1, …
## $ week_31                              <dbl> 5, 5, 20, -5, -10, -3, 0, -10, 20…
## $ week_32                              <dbl> -5, 1, 20, -1, -10, 5, 10, 1, 0, …
## $ week_33                              <dbl> 0, 10, 3, 3, 0, 0, -1, 0, -20, 3,…
## $ week_34                              <dbl> 0, -1, 0, 0, 10, 3, 20, -5, 10, 3…
## $ week_35                              <dbl> 5, -5, 3, -10, 3, -5, 0, 0, 0, 0,…
## $ week_36                              <dbl> 1, 5, 1, -20, 5, 20, -1, -3, 1, 3…
## $ week_37                              <dbl> 0, 0, 10, -1, 10, 3, 3, 0, 20, 1,…
## $ week_38                              <dbl> 10, -1, 0, -5, 5, 5, 20, -5, -3, …
## $ week_39                              <dbl> 3, 5, 1, 10, 20, 0, 5, 1, -5, 0, …
## $ week_40                              <dbl> 0, 0, 5, 1, 5, 1, 10, -5, -20, 3,…
# Changing some variables type to factors
hogwarts <- hogwarts |> mutate(
  across(c(house, course, sex, wandCore, bloodStatus), ~ as.factor(.x))
)

Задания

Столбчатые диаграммы

  1. Постройте барплот (столбчатую диаграмму), отражающую распределение числа студентов по курсу обучения. Примените любую из встроенных тем ggplot. Раскрасьте столбики любым понравившимся вам цветом (можно использовать как словесные обозначения, так и гекскоды). Добавьте цвет контура столбиков. (1 б)
ggplot(hogwarts)+
  geom_bar(aes(x = course, 
               fill = course), 
           colour = "black")+ 
  scale_fill_manual(values = c("1" = "red", "2" = "orange", "3" = "yellow", "4" = "green", "5" = "turquoise2", "6" = "blue", "7" = "violet"))+
  theme_classic()

  1. Создайте новый барплот, отражающий распределение числа студентов по факультету. Добавьте на график вторую факторную переменную – происхождение (bloodStatus). Модифицируйте при помощи аргумента position графика так, чтобы каждый столбец показывал распределение факультета по чистоте крови в долях. Примените произвольную тему. Запишите текстом в rmd-документе, какой вывод можно сделать из графика? (1 б)
theme_custom <- theme(
    axis.title.x = element_text(size = 22), 
    axis.title.y = element_text(size = 22),  
    axis.text.x = element_text(size = 18),    
    axis.text.y = element_text(size = 18),    
    legend.title = element_text(size = 22),   
    legend.text = element_text(size = 18),   
    plot.title = element_text(size = 26),  
    panel.background = element_rect(fill='white'),
    panel.grid.major = element_line(color = 'gray60', size = 0.5),  
    panel.grid.minor = element_line(color = 'gray80', size = 0.25),
    
  )

ggplot(hogwarts)+
  geom_bar(aes(x = course, 
               fill = bloodStatus), 
           position = "fill",
           colour = "black")+ 
  scale_fill_manual(values = c("half-blood" = "pink", "muggle-born" = "yellow", "pure-blood" = "turquoise2"))+
  theme_classic()+
  theme_custom

Из графика можно сделать вывод, что большинство обучающихся на каждом из курсов Хогвартса - полукровки, а меньшинство - маглорожденные. Есть динамика изменения пропорций, но нет определенного тренда на увеличение или уменьшение доли одной из групп волшебников среди новых наборов.

  1. Модифицируйте датасет таким образом, чтобы в нем остались только чистокровные (pure-blood) и маглорожденные студенты (muggle-born). Создайте на основе этих данных график из пункта 2. Добавьте горизонтальную пунктирную линию произвольного цвета на уровне 50%. Дайте осям название на русском языке (1б). Дополнительно: переименуйте на русский язык категории легенды pure-blood и muggle-born (0.5 б).
hogwarts |> 
  filter( bloodStatus != "half-blood") |>
  
  ggplot()+
  geom_bar(aes(x = course, 
               fill = bloodStatus), 
           position = "fill",
           colour = "black")+ 
  scale_fill_manual(values = c("muggle-born" = "yellow", "pure-blood" = "turquoise2"),
                    labels = c("muggle-born" = "Маглорожденные", "pure-blood" = "Чистокровные"))+
  geom_hline(yintercept = 0.50, linetype = "dashed", color = "red") +
  labs(x = "Курс", y = "Доля студентов", fill = "Происхождение") +
  theme_custom

Боксплоты

  1. Отобразите распределение баллов, заработанных студентами на 3-й неделе обучения, по факультетам. Отсортируйте факультеты в порядке убывания медианного балла за 3-ю неделю (мы не останавливались на этом в лекции, но упомянутая в ней функция по умолчанию сортирует именно по медиане, так что в этом случае дополнительных аргументов передавать не следует). (1 б.)
hogwarts |> 
  select(house, week_3)|>
  ggplot()+
  geom_boxplot(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3))+
  labs(x = "Факультет", y = "Оценка за третью неделю") +
  theme_custom

  1. Добавьте отображение разными цветами для происхождения студентов (bloodStatus). Добавьте на боксплот вырезку (notch). Настройте для данного чанка размер изображения 14:14 дюймов. Приведите названия осей к корректному виду. (1 б.)
hogwarts |> 
  select(house, week_3, bloodStatus)|>
  ggplot()+
  geom_boxplot(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3, fill = bloodStatus), notch = TRUE)+
  scale_fill_manual(values = c("muggle-born" = "yellow", "pure-blood" = "turquoise2", "half-blood" = "pink"),
                    labels = c("muggle-born" = "Маглорожденные", "pure-blood" = "Чистокровные", "half-blood" = "полукровки"))+
  labs(x = "Факультет", y = "Оценки за третью неделю", fill = "Происхождение") +
  theme_custom

3. Добавьте на график джиттер-плот. Удалите отображение выбросов у боксплота. Видоизмените по своему вкусу толщину линий и ширину боксплота. (1 б.) Дополнительно: Добавьте название графика и подпись (0.5 б.)

hogwarts |> 
  select(house, week_3, bloodStatus) |>
  ggplot() +
  

  geom_boxplot(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3, fill = bloodStatus), 
               notch = TRUE, 
               outlier.shape = NA,
               size = 1.2, 
               width = 0.6  
  ) +
  geom_jitter(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3),
              width = 0.15, height = 0, size = 2) +
  scale_fill_manual(values = c("muggle-born" = "yellow", "pure-blood" = "turquoise2", "half-blood" = "pink"),
                    labels = c("muggle-born" = "Маглорожденные", "pure-blood" = "Чистокровные", "half-blood" = "Полукровки")) +
  labs(
    title = "Оценки студентов Хогвартса за третью неделю",
    subtitle = "Распределение оценок по факультетам и происхождению студентов",
    x = "Факультет", 
    y = "Оценки за третью неделю", 
    fill = "Происхождение", 
    color = "Происхождение"
  ) +
  

  theme_classic() +
  theme_custom

Разное

  1. Постройте “леденцовый график” (lollipop-plot) для количества набранных студентами 5-го курса баллов за весь учебный год (по оси ординат – id студента, по оси абсцисс – итоговый балл). Отсортируйте студентов в порядке убывания. Раскрасьте точки на “леденцах” в зависимости от сердцевины волшебной палочки. Палочки с сердечной жилой дракона должны быть красного цвета, с пером феникса – желтого, с волосом единорога – серого. (1 б.)
hogwarts |> 
  filter(course == "5") |> 
  mutate(id = as.factor(id)) |> 
  ggplot()+
  geom_segment(aes(x = fct_reorder(id, result, .desc = TRUE), xend = id, y = 0, yend = result))+
  geom_point(aes(x = id, y = result, color = wandCore))+
  scale_color_manual(values = c("dragon heartstring" = "red", "phoenix feather" = "yellow2", "unicorn hair" = "gray50"),
                    labels = c("dragon heartstring" = "Жила дракона", "phoenix feather" = "Перо феникса", "unicorn hair" = "Волос единорога")) +
  
  labs(
    title = "Оценки пятикурсников Хогвартса за весь учебный год",
    x = "Студент", 
    y = "Оценки за учебный год", 
    fill = "Материал палочки", 
    color = "Материал палочки"
  ) +
  
  theme_classic()+
  theme(
    axis.title.x = element_text(size = 22), 
    axis.title.y = element_text(size = 22),  
    axis.text.x = element_text(size = 6),    
    axis.text.y = element_text(size = 20),    
    legend.title = element_text(size = 22),   
    legend.text = element_text(size = 20),   
    plot.title = element_text(size = 26),  
  )

2. Постройте гистограмму распредления баллов за экзамен по астрономии. Выделите цветом факультет Слизерин. Примените 18-й кегль к тексту на осях x, y и легенды. Название оси y и легенды запишите 20-м кеглем, оси x – 22-м. Измените название оси y на “Number of students”. (1 б.)

ggplot()+
  geom_histogram(data = hogwarts, aes(x = `Astronomy exam`, fill = house == "Slytherin"), color = "black", alpha=0.6)+
  scale_fill_manual(values = c("FALSE" = "red", "TRUE" = "#1F5D25"), 
                    labels = c("FALSE" = "Другие факультеты", "TRUE" = "Слизерин")) +
  labs(
    title = "Баллы за экзамен по астрономии", 
    y = "Number of students", 
    fill = "Факультет", 
    color = "Факультет"
  ) +
  theme_classic()+
   theme(
    axis.title.x = element_text(size = 22), 
    axis.title.y = element_text(size = 20),  
    axis.text.x = element_text(size = 18),    
    axis.text.y = element_text(size = 18),    
    legend.title = element_text(size = 20),   
    legend.text = element_text(size = 18),   
    plot.title = element_text(size = 22),  
  )

3. На лекции мы использовали комбинацию theme_bw(), и созданной нами theme_custom, чтобы одновременно сделать фон белым и увеличить шрифт. Модифицируйте theme_custom таким образом, чтобы она и выполняла свои прежние функции, и делала фон белым без помощи theme_bw(). Примените новую кастомную тему к графику, полученному в последнем пункте блока по боксплотам (1.5 б).

theme_custom <- theme(
    axis.title.x = element_text(size = 22), 
    axis.title.y = element_text(size = 22),  
    axis.text.x = element_text(size = 18),    
    axis.text.y = element_text(size = 18),    
    legend.title = element_text(size = 22),   
    legend.text = element_text(size = 18),   
    plot.title = element_text(size = 26),  
    panel.background = element_rect(fill='white'),
    panel.grid.major = element_line(color = 'gray30', size = 0.5),  
    panel.grid.minor = element_line(color = 'gray80', size = 0.25),
    
  )

hogwarts |> 
  select(house, week_3, bloodStatus) |>
  ggplot() +
  
  geom_boxplot(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3, fill = bloodStatus), 
               notch = TRUE, 
               outlier.shape = NA,
               size = 1.2, 
               width = 0.6  
  ) +
  geom_jitter(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3),
              width = 0.15, height = 0, size = 2) +
  scale_fill_manual(values = c("muggle-born" = "yellow", "pure-blood" = "turquoise2", "half-blood" = "pink"),
                    labels = c("muggle-born" = "Маглорожденные", "pure-blood" = "Чистокровные", "half-blood" = "Полукровки")) +
  labs(
    title = "Оценки студентов Хогвартса за третью неделю",
    subtitle = "Распределение оценок по факультетам и происхождению студентов",
    x = "Факультет", 
    y = "Оценки за третью неделю", 
    fill = "Происхождение", 
    color = "Происхождение"
  ) +
  theme_custom

Фасетирование

  1. Напишите, какой, по вашему мнению, способ фасетирования (по строкам или по столбцам) лучше использовать для визуализации гистограммы. Почему? А какой для визуализации violin-plot? Почему? Можно ли вывести общее правило?

Гистограммы, на мой личный вкус, лучше фасетировать по столбцам, чтобы лучше видеть различия по ширине и форме распределений.

Кому-то может больше понравится фасетирование по строкам, чтобы все столбцы были один под другим и было удобнее сравнивать высоту одних и тех же столбиков. Но чисто визуально мне так не нравится.

Для вайолин плот фасетирование по столбцам выглядит лучше, так как удобнее сравнивать ширину виолончелей (количество значений для одинаковых y). Фасетирование по столбцам делает сравнение более естественным, поскольку виолончели располагаются горизонтально и их проще сопоставить по ширине и форме.

В целом мое мнение:

  1. На мой взгяд, способ фасетирования для графиков зависит от количества категорий, а также фасетирование не должно искажать пропорции графика и стирать отличия между значениями.

  2. Фасетирование по строкам лучше подходит, если категорий до 4-5, а фасетирование по столбцам более эффективно, если категорий больше.

  3. Горизонтальные сравнения (когда смотрим слева направо) более естественны для человеческого восприятия.

Общее правило: Все правила визуализации должны быть гибкими в зависимости от типа данных и цели визуализации.

  1. Постройте гистограмму для результата любого выбранного вами экзамена, кроме зельеварения. Настройте оптимальное на ваш взгляд число столбцов гистограммы. Выполните фасетирование по курсу. Постарайтесь, чтобы график был по возможности компактным.

Оптимальная ширина столбца была выбрана по правилу Фридмана-Дьякониса, согласно его формуле ширина столбца = 2 * IQR/ n^(1/3) , где IQR - интерквартильный размах, а n - количество случаев

fd_binwidth <- function(x) {
  IQR_x <- IQR(x) 
  n <- length(x)   
  binwidth <- 2 * IQR_x / n^(1/3)
  return(binwidth)
}
optimal_binwidth <- fd_binwidth(hogwarts$`Care of magical creatures exam`)

ggplot(hogwarts)+
  geom_histogram(aes(x = `Care of magical creatures exam`), 
                 fill = "turquoise2", 
                 colour = "grey49",
                 binwidth = optimal_binwidth
 )+
  theme_custom+
  theme(strip.text = element_text(size = 15))

Фасетирование по курсу

Ширина столбца увеличена и подобрана вручную, так как в каждой гистограмме стало меньше наблюдений, и это число не равно для всех трех графиков

ggplot(hogwarts)+
  geom_histogram(aes(x = `Care of magical creatures exam`), 
                 fill = "turquoise2", 
                 colour = "grey49", 
                 binwidth = 10)+
  facet_wrap(vars(course))+
  theme_bw()+
  theme_custom+
  theme(strip.text = element_text(size = 15))

  1. Отобразите на одном графике распределение плотности вероятности для оценки студентов на экзамене по защите от темных искусств и на экзамене по травологии. Раскрасьте их в любые выбранные вами цвета, постарайтесь, чтобы оба распределения отображались целиком. Примените тему из 3-го пункта блока “Разное”. Сделайте фасетирование по полу.
ggplot(hogwarts)+
  geom_density(aes(x = `Herbology exam`, 
               fill = "Herbology", 
               colour = "Herbology"),
               alpha = 0.5)+
  geom_density(aes(x = `Defence against the dark arts exam`, 
               fill = "Defence against the dark arts", 
               colour = "Defence against the dark arts"),
               alpha = 0.5)+
  facet_wrap(vars(sex))+
  scale_fill_manual(name = "Экзамен", 
                    values = c("Herbology" = "turquoise1", "Defence against the dark arts" = "yellow")) +
  scale_colour_manual(name = "Экзамен", 
                      values = c("Herbology" = "grey49", "Defence against the dark arts" = "grey49")) +
  theme_bw()+
  theme_custom